MacWorld 1999 March - Disc 1/Macworld (1999-03) (Disk 1).dmg/Shareware World/Utilities/Text Processing/Alpha/Tcl/Modes/browserMode.tcl

Text File | 1998-12-06 | 4.7 KB | 163 lines | [TEXT/ALFA]

#=============================================================================
# Browser mode.
#
# Alpha cannot do batch searches without this file
#=============================================================================

alpha::mode Brws 1.0.1 dummyBrws

Bind '\r'        gotoMatch    Brws
Bind enter        gotoMatch    Brws
ascii 0x3          gotoMatch   Brws
Bind down         downBrowse Brws
Bind up         upBrowse Brws
Bind 'n' <z>    downBrowse Brws
Bind 'p' <z>    upBrowse Brws
ascii 0x20        downBrowse Brws
ascii 0x8        upBrowse Brws
# this was below.  do we need it?
Bind 'c' <Cz>        gotoMatch

proc dummyBrws {} {}

proc upBrowse {} {
    set limit [nextLineStart [nextLineStart [minPos]]]
    if {[pos::compare [getPos] > $limit]} {
    set limit [pos::math [getPos] - 1]
    }
    select [lineStart $limit] [nextLineStart $limit]
}

proc downBrowse {} {
    set pos [getPos]
    if {[pos::compare $pos < [nextLineStart [minPos]]]} {
    set pos [nextLineStart [minPos]]
    }
    if {[pos::compare [nextLineStart $pos] != [maxPos]]} {
    select [nextLineStart $pos] [nextLineStart [nextLineStart $pos]]
    }
}

proc nextPrevMatch {{dir 1} {wname "*Batch Find*"}} {
    set wins [winNames]
    set res [lsearch $wins $wname]
    if {$res < 0} {
    set res [lsearch -regexp $wins {\*.*\*}]
    if {$res < 0} return
    }
    set win [lindex $wins $res]
    bringToFront $win
    if {$dir} {
    downBrowse
    } else {
    upBrowse
    }
    gotoMatch
    dispErr $win
}

proc nextMatch {{wname "*Batch Find*"}} {
    nextPrevMatch 1 $wname
}

proc prevMatch {{wname "*Batch Find*"}} {
    nextPrevMatch 0 $wname
}

proc dispErr {{win "* Compiler Errors *"}} {
    if {[string length $win]} {
    set text [getText -w $win [getPos -w $win] [selEnd -w $win]]
    if {[regexp {(Line.*)∞} $text dummy sub]} {
        message "$sub"
    }
    }
}


##############################################################################
#  To be used in the windows created by "matchingLines" or by batch searches.
#
#  With the cursor positioned in a line corrsponding to a match,
#  go back and select the line in the original file that
#  generated this match.  (Like emacs 'Occur' functionality)
#
#  97-08-01 Now doesn't ask if you want a new copy of windows with <n>.
#           Wrap dialog also skipped.
proc gotoMatch {} {
    if {[string match "*MAILBOX*" [win::CurrentTail]]} {
    mailGotoMatch
    return
    }
    global tileHeight tileWidth tileTop tileLeft tileHeight errorHeight errorDisp tileMargin
    set text [getText [lineStart [getPos]] [pos::math [nextLineStart [getPos]] - 1]]
    set ind1 [string first "∞" $text]
    set ind2 [string last "∞" $text]
    if {$ind1 == $ind2} {
    set fname [string trim [string range $text $ind1 end] {∞}]
    set msg ""
    } else {
    set fname [string trim [string range $text $ind1 $ind2] {∞}]
    set msg [string trim [string range $text $ind2 end] {∞}]
    }

    set top $tileTop
    set geo [getGeometry]
    if {([lindex $geo 0] != $tileLeft) || ([lindex $geo 1] != $top) || ([lindex $geo 3] != $errorHeight) } {
    moveWin $tileLeft $top
    sizeWin $tileWidth $errorHeight
    }
    set mar $tileMargin
    incr top [expr $errorHeight + $mar]
    if {[file exists $fname]} {
    edit -c -w -g $tileLeft $top $tileWidth $errorDisp $fname
    set geo [getGeometry]
    if {([lindex $geo 0] != $tileLeft) || ([lindex $geo 1] != $top) || ([lindex $geo 2] != $tileWidth) || ([lindex $geo 3] != $errorDisp) } {
        sizeWin $tileWidth $errorDisp
        moveWin $tileLeft $top
    }
    } else {
    if {![string match "*Link*" [getText [minPos] [nextLineStart [minPos]]]]} {
        alertnote "File \" $fname \" not found."
    }
    return
    }
    if {[regexp {Line ([0-9]+):} $text dummy line]} {
    set pos [rowColToPos $line 0]
    select $pos [nextLineStart $pos]
    }
    message $msg
}

set lastMatchingLines ""

proc matchingLines {{reg ""} {for 1} {ign 1} {word 0} {regexp 1}} {
    global lastMatchingLines

    if {![string length $reg] && [catch {prompt "Regular expression:" $lastMatchingLines} reg]} return
    set lastMatchingLines $reg
    if {![string length $reg]} return
    if {!$regexp} {
    set reg [quote::Regfind $reg]
    }
    if $word {
    set reg "^.*\\b$reg\\b.*$"
    } else {
    set reg "^.*$reg.*$"
    }
    set pos [expr {$for ? [minPos] : [getPos]}]
    set fileName [stripNameCount [win::Current]]
    set matches 0
    set lines {}
    while {![catch {search -s -f 1 -r 1 -i $ign $reg $pos} mtch]} {
    append lines "\r" [format "Line %d: " [lindex [posToRowCol [lindex $mtch 0]] 0]] [eval getText $mtch] "\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t∞$fileName"
    set pos [lindex $mtch 1]
    incr matches
    }
    grepsToWindow {* Matching Lines *} \
      [format "%d matching lines (<cr> to go to match)\r-----" $matches] \
      $lines "\r"
}